PD Collection CD 1

home *** CD-ROM | disk | FTP | other *** search

/ PD Collection CD 1 / PD Collection CD 1.iso / programer2 / siod / !Siod_!RunImage (.txt) < prev next >

Wrap

RISC OS BBC BASIC V Source | 1993-03-15 | 23.1 KB | 810 lines

>$.TMP.!Sml.!RunImage Multitasker for !Sml (c) 1992 Robin Watts bent to do Siod 2.09 screen% 80*32 indir% 1024 windata% 4096 block% 256 code% 10000 menublock% 2048 cblock% 24 ON ERROR MODE MODE:REPORT:PRINT;" at line ";ERL:END assemble initialise getmodevars conch closedown initialise "Wimp_Initialise",200,&4B534154,"Siod Tasker" version%,task% closedown "Wimp_CloseDown",task%,&4B534154 conch setup loadwindows initmenus openwindow(mainwh%, grabcaret vdu(12) !ypos=31 launchsiod closedown% closealltasks setup size%=(!xmax+1)*(!ymax+1) closedown%= !caretowned%=0 prompt%= taskstarted%= loadwindows "Wimp_OpenTemplate",,"<Conch$Dir>.Templates" 9%mainwh%= doloadtemplate(0,"main") :%infowh%= doloadtemplate(1,"info") "Wimp_CloseTemplate" doloadtemplate(n%,ident$) whandle% "Wimp_LoadTemplate",,windata%+n%*2048,indir%+n%*512,indir%+n%*512+512,-1, ident$+ (0))),0 "Wimp_CreateWindow",,windata%+n%*2048 whandle% =whandle% openwindow(wh%,tooldsize%) !block%=wh% tooldsize% "Wimp_GetWindowInfo",,block% block%!28=-1 "Wimp_OpenWindow",,block% "Wimp_Poll",%110001,block% reason%,block% reason% redrawwindow openwindow(!block%, closealltasks mouseclicked keypressed menuselected gaincaret losecaret 17,18,19 block%!16 closealltasks &400C1 getmodevars &808C1 childoutput &808C2 childstarted &808C3 childdied redrawwindow "Wimp_RedrawWindow",,block% more% more%<>0 t. !minx%=(block%!28-block%!4+block%!20) u. !maxx%=(block%!36-block%!4+block%!20) v0 !miny%=-(block%!40-block%!16+block%!24) w2 !maxy%=-(block%!32-block%!16+block%!24) 32+1 redraw "Wimp_GetRectangle",,block% more% closealltasks taskstarted% block%!20=1 block%!16=&808C0 block%!0=28 block%!12=0 block%!24=4 "Wimp_SendMessage",17,block%,handle% taskstarted%= childdied assemble pass%=0 P%=code% [OPT pass% .screen EQUD screen% EQUD 0 .xmax EQUD 79 .ymax EQUD 31 .xwinmax EQUD 79 .xwinmin EQUD 0 .ywinmax EQUD 31 .ywinmin EQUD 0 .xpos EQUD 0 .ypos EQUD 0 .vdusupressed EQUD 0 .followingbytes EQUD 0 .numbertocome EQUD 0 .queueaddr EQUD queue .queue EQUD 0 EQUD 0 EQUD 0 EQUD 0 .bytestoignore EQUD 0 H \ Enter with Vdu Char in vdu @ \ No exit Conditions .dovdu + STMFD R13!,{R0-R12,R14} LDRB R0,vdu ( LDR R1,bytestoignore CMP R1,#0 " BNE ignorebyte ) LDR R1,followingbytes CMP R1,#0 ! BNE following ) CMP R0,#6 :BEQ vduon ' LDR R1,vdusupressed + CMP R1,#1 :BEQ ignore0 * CMP R0,#127:BEQ delete - CMP R0,#32 :BGE printable + CMP R0,#0 :BEQ ignore0 8 CMP R0,#1 : Q R0,#1 :BEQ ignore + CMP R0,#2 :BEQ ignore0 + CMP R0,#3 :BEQ ignore0 + CMP R0,#4 :BEQ ignore0 + CMP R0,#5 :BEQ ignore0 - CMP R0,#7 :BEQ printable - CMP R0,#8 :BEQ backspace 0 CMP R0,#9 :BEQ forwardspace , CMP R0,#10 :BEQ linefeed * CMP R0,#11 :BEQ upline ' CMP R0,#12 :BEQ cls + CMP R0,#13 :BEQ creturn + CMP R0,#14 :BEQ ignore0 + CMP R0,#15 :BEQ ignore0 + CMP R0,#16 :BEQ ignore0 8 CMP R0,#17 : Q R0,#1 :BEQ ignore 8 CMP R0,#18 : Q R0,#2 :BEQ ignore 8 CMP R0,#19 : Q R0,#5 :BEQ ignore + CMP R0,#20 :BEQ ignore0 * CMP R0,#21 :BEQ vduoff 8 CMP R0,#22 : Q R0,#1 :BEQ ignore 8 CMP R0,#23 : Q R0,#9 :BEQ ignore 8 CMP R0,#24 : Q R0,#8 :BEQ ignore 8 CMP R0,#25 : Q R0,#5 :BEQ ignore ) CMP R0,#26 :BEQ vdu26 + CMP R0,#27 :BEQ ignore0 . CMP R0,#28 :BEQ textwindow 8 CMP R0,#29 : Q R0,#4 :BEQ ignore ( CMP R0,#30 :BEQ home ' CMP R0,#31 :BEQ tab .ignore0 * LDMFD R13!,{R0-R12,PC} .vduon MOV R0,#0 ' STR R0,vdusupressed B ignore0 .delete 3 MOV R0,#8 :STR R0,vdu:BL dovdu 3 MOV R0,#32 :STR R0,vdu:BL dovdu 3 MOV R0,#8 :STR R0,vdu:BL dovdu LDR R1,xpos LDR R2,ypos " BL changedbox B ignore0 .backspace LDR R0,xpos LDR R1,ypos " LDR R2,xwinmin " LDR R3,ywinmin " LDR R4,xwinmax " LDR R5,ywinmax SUB R0,R0,#1 STR R0,xpos CMP R0,R2 BGE ignore0 MOV R0,R4 STR R0,xpos SUB R1,R1,#1 STR R1,ypos CMP R1,R3 BGE ignore0 ) BL scrolldownoneline MOV R1,R3 STR R1,ypos B ignore0 .forwardspace LDR R0,xpos LDR R1,ypos " LDR R2,xwinmin " LDR R3,ywinmin " LDR R4,xwinmax " LDR R5,ywinmax ADD R0,R0,#1 STR R0,xpos CMP R0,R4 BLE ignore0 MOV R0,R2 STR R0,xpos ADD R1,R1,#1 STR R1,ypos CMP R1,R5 BLE ignore0 ' BL scrolluponeline MOV R1,R5 STR R1,ypos B ignore0 .linefeed MOV R0,#13 STR R0,vdu BL dovdu LDR R0,xpos LDR R1,ypos $" LDR R2,xwinmin %" LDR R3,ywinmin &" LDR R4,xwinmax '" LDR R5,ywinmax ( ADD R1,R1,#1 STR R1,ypos CMP R1,R5 BLE ignore0 ,' BL scrolluponeline MOV R1,R5 STR R1,ypos B ignore0 .upline LDR R0,xpos LDR R1,ypos 3" LDR R2,xwinmin 4" LDR R3,ywinmin 5" LDR R4,xwinmax 6" LDR R5,ywinmax 7 SUB R1,R1,#1 STR R1,ypos CMP R1,R3 BGE ignore0 ;) BL scrolldownoneline MOV R1,R3 STR R1,ypos B ignore0 @" LDR R1,xwinmax A" LDR R2,ywinmax B! BL changedbox MOV R4,R1 MOV R5,R2 E" LDR R1,xwinmin F" LDR R2,ywinmin G! BL changedbox MOV R3,R2 MOV R2,R1 LDR R6,xmax K ADD R6,R6,#1 L! LDR R8,screen MOV R9,#&20 MOV R1,R3 .clslp1 MOV R0,R2 .clslp2 R# MLA R7,R1,R6,R8 S ADD R7,R7,R0 T STRB R9,[R7] U ADD R0,R0,#1 CMP R0,R4 BLE clslp2 X ADD R1,R1,#1 CMP R1,R5 BLE clslp1 STR R2,xpos STR R3,ypos B ignore0 .creturn _" LDR R0,xwinmin STR R0,xpos B ignore0 .vduoff MOV R0,#1 d' STR R0,vdusupressed B ignore0 .vdu26 MOV R0,#0 h" STR R0,xwinmin i" STR R0,ywinmin STR R0,xpos STR R0,ypos LDR R0,xmax m" STR R0,xwinmax LDR R0,ymax o" STR R0,ywinmax B ignore0 .textwindow MOV R0,#28 s) STR R0,followingbytes MOV R0,#4 u' STR R0,numbertocome B ignore0 .textwindow2 x# LDRB R0,queue+3 y# LDRB R1,queue+2 z# LDRB R2,queue+1 {! LDRB R3,queue LDR R4,xmax LDR R5,ymax CMP R0,R2 BGT ignore0 CMP R1,R3 BLT ignore0 CMP R2,R4 BGT ignore0 CMP R3,R5 BGT ignore0 " STR R0,xwinmin " STR R1,ywinmax " STR R2,xwinmax " STR R3,xwinmin B ignore0 .home " LDR R0,xwinmin STR R0,xpos " LDR R1,ywinmin STR R2,ypos B ignore0 MOV R0,#31 ) STR R0,followingbytes MOV R0,#2 ' STR R0,numbertocome B ignore0 .tab2 # LDRB R0,queue+1 ! LDRB R1,queue " LDR R2,xwinmin " LDR R3,ywinmin " LDR R4,xwinmax " LDR R5,ywinmax ADD R0,R0,R2 ADD R1,R1,R3 CMP R0,R4 BGT ignore0 CMP R1,R5 BGT ignore0 STR R0,xpos STR R1,ypos B ignore0 .ignore ( STR R0,bytestoignore B ignore0 .ignorebyte SUB R0,R0,#1 ( STR R0,bytestoignore B ignore0 .following ' LDR R2,numbertocome $ LDR R3,queueaddr ! SUBS R2,R2,#1 # STRB R0,[R3,R2] ' STR R2,numbertocome BGE ignore0 / CMP R1,#28 :BEQ textwindow2 ( CMP R1,#31 :BEQ tab2 B ignore0 .printable ! LDR R5,screen LDR R1,xpos LDR R2,ypos ! BL changedbox LDR R4,xmax ADD R4,R4,#1 # MLA R5,R4,R2,R5 # STRB R0,[R5,R1] " B forwardspace .scrolldownoneline + STMFD R13!,{R0-R12,R14} " LDR R1,xwinmax " LDR R2,ywinmax ! BL changedbox MOV R3,R2 " LDR R1,xwinmin " LDR R2,ywinmin ! BL changedbox MOV R0,R1 MOV R1,R2 " LDR R2,xwinmax CMP R1,R3 & BEQ blankfirstline ! LDR R4,screen LDR R7,xmax ADD R7,R7,#1 SUB R8,R3,#1 .sdollp1 MOV R9,R0 .sdollp2 # MLA R6,R7,R8,R4 # LDRB R5,[R6,R9] ADD R6,R6,R7 # STRB R5,[R6,R9] ADD R9,R9,#1 CMP R9,R7 BLE sdollp2 SUB R8,R8,#1 CMP R8,R1 BGE sdollp1 .blankfirstline # MLA R6,R7,R1,R4 MOV R9,R0 MOV R5,#32 .sdollp3 # STRB R5,[R6,R9] ADD R9,R9,#1 CMP R9,R2 BLE sdollp3 * LDMFD R13!,{R0-R12,PC} .scrolluponeline + STMFD R13!,{R0-R12,R14} BL scrollbox " LDR R2,xwinmax " LDR R3,ywinmax " LDR R0,xwinmin " LDR R1,ywinmin CMP R1,R3 % BEQ blanklastline ! LDR R4,screen LDR R7,xmax ADD R7,R7,#1 ADD R8,R1,#1 .suollp1 MOV R9,R0 .suollp2 # MLA R6,R7,R8,R4 # LDRB R5,[R6,R9] SUB R6,R6,R7 # STRB R5,[R6,R9] ADD R9,R9,#1 CMP R9,R7 BLE suollp2 ADD R8,R8,#1 CMP R8,R3 BLE suollp1 .blanklastline # MLA R6,R7,R3,R4 MOV R9,R0 MOV R5,#32 .suollp3 # STRB R5,[R6,R9] ADD R9,R9,#1 CMP R9,R2 BLE suollp3 * LDMFD R13!,{R0-R12,PC} .changedbox + STMFD R13!,{R0-R12,R14} # LDR R0,changed% CMP R0,#0 & BNE changedalready & STR R1,changeminx% & STR R1,changemaxx% & STR R2,changeminy% & STR R2,changemaxy% MOV R1,#1 # STR R1,changed% * LDMFD R13!,{R0-R12,PC} .changedalready & LDR R0,changeminx% 2 CMP R1,R0:STRLT R1,changeminx% & LDR R0,changemaxx% 2 CMP R1,R0:STRGT R1,changemaxx% & LDR R0,changeminy% !2 CMP R2,R0:STRLT R2,changeminy% "& LDR R0,changemaxy% #2 CMP R2,R0:STRGT R2,changemaxy% $* LDMFD R13!,{R0-R12,PC} .scrollbox &+ STMFD R13!,{R0-R12,R14} '# LDR R0,changed% CMP R0,#0 )+ BLNE changebeforescroll *$ LDR R0,scrolled% CMP R0,#0 , BNE scrolled -" LDR R0,xwinmin .& STR R0,scrollminx% /" LDR R0,xwinmax 0& STR R0,scrollmaxx% 1" LDR R0,ywinmin 2& STR R0,scrollminy% 3" LDR R0,ywinmax 4& STR R0,scrollmaxy% MOV R0,#1 6' STR R0,scrollcount% 7$ STR R0,scrolled% 8* LDMFD R13!,{R0-R12,PC} .scrolled :" LDR R0,xwinmin ;& LDR R1,scrollminx% <. CMP R0,R1:BNE scrollnewwin =" LDR R0,ywinmin >& LDR R1,scrollminy% ?. CMP R0,R1:BNE scrollnewwin @" LDR R0,xwinmax A& LDR R1,scrollmaxx% B. CMP R0,R1:BNE scrollnewwin C" LDR R0,ywinmax D& LDR R1,scrollmaxy% E. CMP R0,R1:BNE scrollnewwin F' LDR R0,scrollcount% G ADD R0,R0,#1 H' STR R0,scrollcount% I* LDMFD R13!,{R0-R12,PC} .scrollnewwin K" LDR R0,xwinmin L& LDR R1,changeminx% M2 CMP R0,R1:STRLT R0,changeminx% N" LDR R0,xwinmax O& LDR R1,changemaxx% P2 CMP R0,R1:STRGT R0,changemaxx% Q" LDR R0,ywinmin R& LDR R1,changeminy% S2 CMP R0,R1:STRLT R0,changeminy% T" LDR R0,ywinmax U& LDR R1,changemaxy% V2 CMP R0,R1:STRGT R0,changemaxy% W. MOV R0,#0:STR R0,scrolled% X- MOV R0,#1:STR R0,changed% Y* LDMFD R13!,{R0-R12,PC} .changebeforescroll [+ STMFD R13!,{R0-R12,R14} \& LDR R0,changeminy% ] SUB R0,R0,#1 ^& STR R0,changeminy% _* LDMFD R13!,{R0-R12,PC} .scrolled% EQUD 0 .scrollminx% EQUD 0 .scrollminy% EQUD 0 .scrollmaxx% EQUD 0 .scrollmaxy% EQUD 0 .scrollcount% EQUD 0 .changed% EQUD 0 .changeminx% EQUD 0 .changeminy% EQUD 0 .changemaxx% EQUD 0 .changemaxy% EQUD 0 .caretowned% EQUD 0 .block EQUD block% .xpix% EQUD 0 .ypix% EQUD 0 .minx% EQUD 0 .miny% EQUD 0 .maxx% EQUD 0 .maxy% EQUD 0 .double% EQUD 0 .redraw + STMFD R13!,{R0-R12,R14} LDR R3,miny% ) CMP R3,#0:MOVLT R3,#0 LDR R4,maxy% LDR R5,ymax ) CMP R4,R5:MOVGT R4,R5 LDR R5,minx% ) CMP R5,#0:MOVLT R5,#0 LDR R6,maxx% LDR R12,xmax " ADD R12,R12,#1 + CMP R6,R12:MOVGT R6,R12 MOV R7,#16 MOV R8,#32 LDR R9,block " LDR R11,screen .redrawlp1 MOV R0,#4 # LDR R10,[R9,#4] # LDR R1,[R9,#20] ! SUB R1,R10,R1 # MLA R1,R5,R7,R1 $ LDR R10,[R9,#24] $ MLA R2,R3,R8,R10 $ LDR R10,[R9,#16] ! SUB R2,R10,R2 ! SWI "OS_Plot" MOV R14,R5 % MLA R1,R3,R12,R11 .redrawlp2 $ LDRB R0,[R1,R14] # SWI "OS_WriteC" " ADD R14,R14,#1 CMP R14,R6 ! BLE redrawlp2 ADD R3,R3,#1 CMP R3,R4 ! BLE redrawlp1 * LDMFD R13!,{R0-R12,PC} getmodevars !block%=0 block%!4=4 block%!8=5 block%!12=-1 "OS_ReadVduVariables",block%,block%+40 xeig%=block%!44 yeig%=block%!48 !xpix%=1<<xeig% !ypix%=1<<yeig% "!double%=((block%!40) 32)>>5 grabcaret "Wimp_SetCaretPosition",mainwh%,-1,!xpos*8*!xpix%,-(!ypos+1)*32,32,0 !caretowned%=1 gaincaret losecaret mouseclicked button% button%=block%!8 (button% 4)=4 grabcaret (button% 2)=2 popupmenu popdownmenu keypressed char% char%=block%!24 !block%=mainwh% char%=(char% 255) block%!20=1 block%!16=&808C0 block%!0=28 block%!12=0 block%!24=char% "Wimp_SendMessage",17,block%,handle% "Wimp_ProcessKey",block%!24 "Wimp_ProcessKey",block%!24 launchsiod taskwindow("<Siod$Dir>.!Siod209 -i<Scm$Dir>.siod_scm -h20000") taskwindow(str$) command$ {command$="TaskWindow """+str$+""" -quit -wimpslot 640K -name ""Siod Engine"" -task &"+ ~(task%)+" -txt &00000000 -ctrl" "Wimp_StartTask",command$ childstarted handle%=block%!4 inputto%=block%!20 taskstarted%= childoutput dovduat(block%+20) dovduat(addr%) "Wimp_GetCaretPosition",,cblock% !cblock%=mainwh% !caretowned%=1 !caretowned%=0 !changed%=0 !scrolled%=0 l%=0 (!addr%)-1 !vdu=l%?(addr%+4) dovdu !scrolled%>0 !caretowned% "Wimp_SetCaretPosition",mainwh%,-1,-100,-100,32,0 "Wimp_BlockCopy",mainwh%,!scrollminx%*16,-(!scrollmaxy%+1)*32,(!scrollmaxx%+1)*16,-!scrollminy%*32+!ypix%-!scrollcount%*32,!scrollminx%*16,-(!scrollmaxy%+1)*32+!scrollcount%*32 "Wimp_ForceRedraw",mainwh%,!scrollminx%*16,-(!scrollmaxy%+1)*32,(!scrollmaxx%+1)*16,-(!scrollmaxy%+1)*32+!scrollcount%*32 !caretowned% "Wimp_SetCaretPosition",mainwh%,-1,!xpos*8*!xpix%,-(!ypos+1)*32,32,0 !changed%>0 "Wimp_ForceRedraw",mainwh%,!changeminx%*16,-(!changemaxy%+1)*32,(!changemaxx%+1)*16,-!changeminy%*32+!ypix% !caretowned% !scrolled% "Wimp_SetCaretPosition",mainwh%,-1,!xpos*8*!xpix%,-(!ypos+1)*32,32,0 vdu(n%) !changed%=0 !vdu=n% dovdu !changed%>0 "Wimp_ForceRedraw",mainwh%,!changeminx%*8*!xpix%,-(!changemaxy%+1)*(8<<!double%)*!ypix%,(!changemaxx%+1)*8*!xpix%,-!changeminy%*(8<<!double%)*!ypix%+!ypix% childdied "Wimp_GetCaretPosition",,cblock% !cblock%=mainwh% "Wimp_SetCaretPosition",-1 closedown%= initmenus menuendptr%=menublock%+64 makemenu("Siod|Info|Quit",menuendptr%,0,menublock%) attachwindow(infowh%,0,0) makemenu(str$, ptr%,no%,menublock%) str1$,off% str$+="|" menublock%!(no%<<2)=ptr% str1$= slice(str$) $ptr%=str1$ 8+ptr%?12=7:ptr%?13=2:ptr%?14=7:ptr%?15=0 ptr%!16=12*16 ptr%!20=44 ptr%!24=0 off%=28 str1$= slice(str$) ptr%!off%=0 str$="" ptr%!off%=ptr%!off% (1<<7) ptr%!(off%+4)=-1 B- ptr%!(off%+8)=&10021 + (7<<24) + (0<<28) str1$,1) str1$= str1$,2) F# ptr%!off%=ptr%!off% (1<<2) G+ ptr%!(off%+8)=ptr%!(off%+8) (1<<8) H. ptr%!(off%+12)= str1$, str1$,",")-1)) ptr%!(off%+16)=0 J. ptr%!(off%+20)= str1$, str1$,",")+1)) $(ptr%+off%+12)=str1$ off%+=24 str$="" ptr%+=off% attachmenu(submenu%,item%,parentmenu%) ptr% U$ptr%=menublock%!(parentmenu%<<2) V/ptr%!(32+item%*24)=menublock%!(submenu%<<2) attachwindow(window%,item%,parentmenu%) ptr% [$ptr%=menublock%!(parentmenu%<<2) ptr%!(32+item%*24)=window% slice( str$) return$ return$= str$, str$,"|")-1) str$= str$, str$,"|")+1) =return$ popupmenu "Wimp_CreateMenu",,menublock%+64,(block%!0)-64,(block%!4) popdownmenu "Wimp_CreateMenu",,-1 menuselected block%!0 closealltasks